(in-package :netrisd)

;;;;;;;;;;;;;;;;;;;;;;
;;   packet types   ;;
;;  (from netris.h) ;; 
;;;;;;;;;;;;;;;;;;;;;;

(defconstant NP_endConn 0)
(defconstant NP_giveJunk 1)
(defconstant NP_newPiece 2)
(defconstant NP_down 3)
(defconstant NP_left 4)
(defconstant NP_right 5)
(defconstant NP_rotate 6)
(defconstant NP_drop 7)
(defconstant NP_clear 8) 
(defconstant NP_insertJunk 9)
(defconstant NP_startConn 10)
(defconstant NP_userName 11)
(defconstant NP_pause 12)
(defconstant NP_version 13)
(defconstant NP_byeBye 14)

(defclass packet ()
  ((type :accessor packet-type :initarg :type)
   (size :accessor packet-size :initarg :size)
   (data :accessor packet-data :initarg :data)))

(defmacro with-packet (packet &rest body)
  `(let ((type (packet-type ,packet))
	 (size (packet-size ,packet))
	 (data (packet-data ,packet)))
     ,@body))

(defmacro with-packets (packets socket &rest body)
  `(let ,(mapcar #'(lambda (p) `(,p (read-packet socket))) 
		 packets)
     ,@body))

(defun read-bytes (num socket)
  (unless (zerop num)
    (multiple-value-bind (data len peer-address) (socket-receive socket nil num) 
      (string-to-list data))))


(defun read-header (socket)
  (read-bytes 4 socket))

(defun write-bytes (bytes socket)
  (if (null bytes)
      0
    (let ((data (coerce bytes '(simple-array (unsigned-byte 8) (*)))))
      (socket-send socket data (length data)))))

(defun read-packet (socket)
  (let ((header (read-header socket)))
    (multiple-value-bind (type size) (first-n 2 header)
      (let ((type (list-to-num type))
	    (size (list-to-num size)))
	    (make-instance 'packet :type type
			   :size size
			   :data (read-bytes (- size 4) socket))))))

(defun write-packet (packet socket)
  (with-packet packet
    (aif (= (+ (write-bytes (nconc (num-to-list 2 type) 
				   (num-to-list 2 size)) socket) 
	       (write-bytes data socket)) size)
	 it
	 (socket-error (format nil 
			"Network error. Sent ~A packets, but had to send ~A." 
			it size)))))

(defun list-to-num (lst) 
  (labels ((ltn (lst num pos acc)
	     (if (null lst)
		 acc
		 (ltn (cdr lst) (1+ num) (+ pos 8) 
		      (dpb (car lst) (byte 8 pos) acc)))))
    (ltn (reverse lst) 0 0 0)))

(defun num-to-list (len num) 
  (do* ((pos 0 (+ pos 8))
	(count 1 (1+ count))
	(result (list (ldb (byte 8 0) num))
		(cons (ldb (byte 8 pos) num) result)))
       ((= count len) result)
    (list pos count result)))


(defun read-int (lst)
  (multiple-value-bind (first last) (first-n 4 data)
    (values (list-to-num first) last)))

